;; sudoku

;; $Id: sudoku.clj 17 2009-05-27 17:39:50Z tzach.livyatan@gmail.com $
;; Sudoku solver by Tzach
;; with the help of Konrad and Keith
;; now with GUI and a new problem generator!


(ns sudoku
    (:require [clojure.zip :as zip])
    (:use clojure.contrib.walk)
    (:use clojure.contrib.trace)
    (:gen-class))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; generic util functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn mod3range [x]
  (let [start (- x (rem x 3))]
       (range start (+ 3 start))))

(defn parse-integer [str]
  (try (Integer/parseInt str)
       (catch NumberFormatException nfe 0)))

(defn abs [x]
  (if (> 0 x) (- x) x))

(defn parse-digit [str]
  (abs (rem (parse-integer str) 10)))

(defmacro ret-time
  "Evaluates expr and return the time it took and value of expr in seconds"
  [expr]
  `(let [start# (. System (nanoTime))
         ret# ~expr]
     [ret# (int (/ (double (- (. System (nanoTime)) start#)) 1000000.0))]))
     
(defn currency-format [num]
  (format "%,.0f" (float num)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; sudoku logic
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn print-board [board]
  "Pretty print the sudoku board"
  (println)
  (doseq [row board] (println row)))


(defn neighbors-pos [pos]
  "return a collection of neighbors positions to pos"
  (remove #(= pos %)
    (distinct (concat
         (for [y (range 3) z (range 3)] [(get pos 0) y z]) ; row neighbors
         (for [x (range 9)] [x (get pos 1) (get pos 2)]) ; col neighbors
         (for [x (mod3range (get pos 0)) z (range 3)] [x (get pos 1) z]))) ; square neighbors;
    ))

(def neighbors-pos (memoize neighbors-pos))

(defn neighbors-values [board pos]
      "return a list of neighbor positions values"
      (map #(get-in board %) (neighbors-pos pos)))

(defn valid-values [board pos]
      "return a list of values which does not violate the neighbors values."
      (clojure.set/difference (set (range 1 10)) (set (neighbors-values board pos))))


(defn map-board [board f]
      "execute function f on each of the position on board. function f get the position and the board as parameters"
      (for [x (range 9) y (range 3) z (range 3)]
     (let [pos [x y z]]
    [pos (f board pos) ]
    )))

(defn next-cell [board]
  "return the next potential cell to set, and the valid alternatives"
  (let [w (map-board board valid-values)]
       (first
  (apply concat (for [n (range 1 10)]
         (filter
          #(and (= n (count (second %))) (zero? (get-in board (first %))))
          w))))))

(defn complete? [board]
  (not (some #(second %)
       (map-board board (fn [board pos] (zero? (get-in board pos)))))))

(defn lazy-all-solutions [board]
  "return all valid solution to a sudoku problem
if you do not have all day, use it in a lazy way"
  (lazy-seq
   (if (complete? board)
       (list board)
       (let [[pos valid-values] (next-cell board)]
      (apply concat (for [v valid-values]
             (lazy-all-solutions (assoc-in board pos v))))))))

(defn is-legal?
    ([board pos]
      "check the value in pos is valid"
      (let [val (get-in board pos)]
     (or (zero? val) (contains? (valid-values board pos) val))))
  ([board]
   "check if board is valid"
   (every? true? (map second (map-board board is-legal?)))))

(defn sudoku [board]
  "solve a sudoku problem"
  (if (is-legal? board)
      (first (lazy-all-solutions board))))

(def *empty-board*
    (vec
     (for [x (range 9)]
    [[0 0 0] [0 0 0] [0 0 0]])))

(def *core-sudoku* (sudoku *empty-board*))

;;; use the solver: (print-board (sudoku (generate-board 3)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; generate new problems
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn rand-board [board]
  "switch random two didigt in a board, repaet for num times"
  (loop [cnt 10, board board]
  (if (zero? cnt) board
      (let [a (inc (rand-int 9))
     b (inc (rand-int 9))]
     (recur (dec cnt) (postwalk-replace { a b b a } board ) )))))

(defn make-problem [board num]
      "replace num of the digits in the board by zero"
      (if (< num 1) board
    (recur (assoc-in board [(rand-int 9) (rand-int 3) (rand-int 3)] 0) (dec num))))

(defn generate-board [hard]
  "creatre s new proble. Hard is a degree on the scale of 1 to 4"
  (make-problem (rand-board *core-sudoku*) (* 20 (+ 2 hard))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Sudoku GUI
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(import '(javax.swing JFrame JTextField JOptionPane JMenuItem JFileChooser JFormattedTextField)
  '(javax.swing.text MaskFormatter)
  '(java.awt.event ActionListener)
  '(java.awt ComponentOrientation)
  '(javax.swing.event MenuListener)
  '(java.awt GridLayout Component FileDialog Color Font))

(use 'clojure.contrib.duck-streams)

(defn components [container]
  "return a sequnce of a swing components"
  (for [i (range (.getComponentCount container))]
       (.getComponent container i)))


(defn switch-rep [alist]
  "replace board represntatoin"
  (vec (mapcat
  (fn [x] (for [r (range 3)]
         (vec (map #(vec (nth % r)) (take 3 x))))) (partition 3 alist))))

(defn get-gui-board [frame]
  "convert a the sudoko GUI to a vector base board"
  (switch-rep
   (for [square (components (.getContentPane frame))]
  (partition 3
       (for [cell (components square)]
      (parse-digit (.getText cell)))))))

(defn pairs [a b]
      "return a sequnce of pairs from elements of a , b"
      (for [[x y] (partition 2 (interleave a b)) ] (list x y)))

(defn set-gui-board [board frame]
      "set a gui board from values in board"
      (doseq [[x r] (pairs (switch-rep board) (components (.getContentPane frame)))]
       (doseq [[v t] (pairs (apply concat x) (components r))]
        (doto t
        (.setText (if (zero? v) "" (str v)))
        (.setCaretPosition 0)))))

(def *about-text*
    "Sudoku Solver v17 is a demo application\n created by Tzach as an excersize in Clojure\n 2009")

(defmacro add-item-action [item action]
    "add a action as a listener listener to a item"
    `(.addActionListener ~item
      (proxy [ActionListener] []
       (~'actionPerformed [~'evt] ~action))))


(defn msg-box [text]
  (JOptionPane/showMessageDialog nil, text))


(defn square []
  (let [square (javax.swing.JPanel. (java.awt.GridLayout. 3 3))]
       (doseq [z (range 9)]
        (let [cell (JFormattedTextField. (MaskFormatter. "#"))]
       (.setHorizontalAlignment cell JTextField/CENTER)
       (.setFont cell (java.awt.Font. "SansSerif", java.awt.Font/BOLD, 16))
       (.add square cell )))
       square))

(defn create-frame []
  (let [frame (javax.swing.JFrame. "Sudoku Solver!")]
       (doseq [x (range 9)]
        (.add frame (square)))
       (doto frame
       (.setLayout (java.awt.GridLayout. 3 3 3 2))
       (.setForeground (java.awt.Color/black))
       (.setSize 300 300)
      (.setDefaultCloseOperation JFrame/EXIT_ON_CLOSE)
       )
       frame))



(defn create-board-gui ([]
      "create a Sudoku GUI"
      (let [frame (create-frame)
           bar (javax.swing.JMenuBar.)
           solve-item (JMenuItem. "Solve")
           open-item (JMenuItem. "Open")
           save-item (JMenuItem. "Save")
           clear-item (JMenuItem. "Clear")
           about-item (JMenuItem. "About")
           exit-item (JMenuItem. "Exit")
           easy-item (JMenuItem. "Easy")
           medium-item (JMenuItem. "Medium")
           hard-item (JMenuItem. "Hard")
           file-menu (javax.swing.JMenu. "File")
           new-menu (javax.swing.JMenu. "New Problem")
           file-chooser (javax.swing.JFileChooser. ".")
           ]

           (add-item-action about-item (msg-box *about-text*))
           (add-item-action solve-item (let [[solution mil-sec] (ret-time (sudoku (get-gui-board frame)))]
                    (if solution
                      (do
                        (set-gui-board solution frame) 
                        (msg-box (print-str "Solved in " (currency-format mil-sec) "milliseconds"))
                        )
                      (msg-box "Impossible!\n are you sure the input is valid?"))))
           (add-item-action exit-item (.dispose frame))
           (add-item-action save-item (do
               (.showSaveDialog file-chooser frame)
               (let [file (.getSelectedFile file-chooser)]
                    (when file (spit file (get-gui-board frame))))))
           (add-item-action open-item (do
               (.showOpenDialog file-chooser frame)
               (let [file (.getSelectedFile file-chooser)]
                    (when file (set-gui-board (load-string (slurp* file)) frame)))))
           (add-item-action clear-item (set-gui-board *empty-board* frame))
           (add-item-action easy-item (set-gui-board (generate-board 1) frame))
           (add-item-action medium-item (set-gui-board (generate-board 2) frame))
           (add-item-action hard-item (set-gui-board (generate-board 3) frame))

           (doto file-menu
           (.add solve-item)
           (.add open-item)
           (.add save-item)
           (.add clear-item)
           (.add about-item)
           (.add exit-item))
           (doto new-menu
           (.add easy-item)
           (.add medium-item)
           (.add hard-item))
           (doto file-chooser
           (.setDialogTitle "Soduko File"))
           (doto bar
           (.add file-menu)
           (.add new-menu))
           (doto frame
           (.setJMenuBar bar)
           (.applyComponentOrientation ComponentOrientation/LEFT_TO_RIGHT)
           (.setVisible true))
           frame))
  ([problem]
    (let [frame (create-board-gui)]
        (set-gui-board problem frame)
        frame)))

;; use
;; (create-board-gui)
;; or (def *frame* (-main))
;;  (doto *frame* (.setVisible false) (.setVisible true))

(defn -main [] (create-board-gui (generate-board 1)))